Collection of Tools & Utilities/Collection of Tools and Utilities.iso/sound/adda10.zip/ADDA.PAS

Pascal/Delphi Source File | 1992-09-24 | 9KB | 344 lines

program ADDA(Input, Output);

{ This program is to be used in conjunction with the analog extension
  board described in the note "ANALOG I/O BOARD FOR PC'S". It is assumed
  that the AD7569 is operated in one of its two bipolar modes (-1.25 V -->
  +1.25 V or -2.5 --> +2.5 V). }

uses Dos, Crt, Graph;

const Title= 'ADDA V1.0 - Jos Groot (September 24, 1992)';

{$R-} { this prevents Turbo Pascal from complaining about putting a Byte
        into a ShortInt type variable }

const Status = $300 ;  { bit 0 is 1 when an AD conversion is going on and
                        becomes 0 upon completion of the conversion }
      ADC    = $301 ;  { read : get result of most recently completed AD
                        conversion and start the next }
      DAC    = ADC  ;  { write: start DA conversion }
      Max_Sam= 60000;  { maximum number of samples }

var Buf: array[0..Max_Sam] of ShortInt; { global array receiving samples }

{ ******* }

procedure Initialize_Graphics;

{ initializes graphics mode }

var GraphMode, GraphDriver, ErrorCode: Integer;

begin
  GraphDriver:= Detect;
  InitGraph(GraphDriver,GraphMode,'.');
  ErrorCode:= GraphResult;

  if ErrorCode<> GrOk then
  begin
    WriteLn; WriteLn;
    WriteLn('Graphics error: ', GraphErrorMsg(ErrorCode));
    WriteLn('Sorry, I have to quit...');
    Halt(1)
  end;

  SetColor(White)
end;

{ ******* }

procedure Flush_Keyboard_Buffer;

{ flushes the keyboard buffer by reading all pending characters }

var Kar: Char;

begin
  while KeyPressed do Kar:= ReadKey
end;

{ ******* }

procedure Get_Samples(Samples: Word);

{ reads as fast as possible samples 0,1,...,Samples into array Buf. Sample
  Buf[0] should not be used, because this is the ADC result of a conversion
  started at an unknown earlier time. }

var i: Word;
    Pause: Integer;

begin
  for i:= 0 to Samples do { start at 0, 1 is the first good sample to use }
  begin
    asm   { small delay to enable the ADC to complete a conversion before  }
      nop { reading the result. The necessity and length of this delay may }
      nop { vary for different AD7569's. }
      nop
    end;

{   for Pause:= 1 to 50 do;} { add this loop to decrease sampling frequency }

    Buf[i]:= Port[ADC] { get and store sample & initiate next conversion }
  end
end;

{ ******* }

procedure Compute_Statistics(Samples: Word;
                             var Average, RMS_Amp: Real;
                             var Min, Max: ShortInt);

{ computes the average, RMS amplitude, minimum and maximum of the samples
  Buf[1], Buf[2], ..., Buf[Samples] }

var s: ShortInt;
    i: Word;
    Sum, Sum2: Real;

begin
  Sum :=    0;
  Sum2:=    0; { sum of squares }
  Min :=  127;
  Max := -128;

  for i:= 1 to Samples do
  begin
    s:= Buf[i];
    Sum := Sum  + s;
    Sum2:= Sum2 + Sqr(s);
    if s< Min then Min:= s;
    if s> Max then Max:= s
  end;

  Average:= Sum/Samples;
  RMS_Amp:= Sqrt(Sum2/Samples - Sqr(Average))
end;

{ ******* }

procedure Sampling_Frequency(var Fs: Real);

{ computes the sampling frequency Fs of procedure Get_Samples from the time
  it takes to measure n*Max_Sam samples }

const n= 20;

var h, m, s, s100: Word;
    i: Integer;
    Start, Duration: LongInt;

begin
  WriteLn; WriteLn; WriteLn;
  Write('Taking ', n*Max_Sam:1, ' samples at ... ');
  Gettime(h, m, s, s100);
  Start:= Round(360000.0*h+6000.0*m+100.0*s+s100);

  for i:= 1 to n do Get_Samples(Max_Sam);

  Gettime(h, m, s, s100);
  Duration:= Round(360000.0*h+6000.0*m+100.0*s+s100) - Start;
  Fs:= n*Max_Sam/Duration/10;
  Write(Fs:1:1, ' KHz sampling frequency approximately.');

  repeat until KeyPressed
end;

{ ******* }

procedure Plot_Samples;

{ takes samples and plots these with some statistical information }

var x, CenterY, MinY, MaxY, Samples: Integer;
    Min, Max: ShortInt;
    Average, RMS_Amp: Real;
    Ave, RMS, Mi, Ma: String[6];

begin
  Initialize_Graphics;

  Samples:= GetMaxX+1;    { number of samples to take and plot    }

  CenterY:= GetMaxY div 2;
  MinY:= CenterY-127;     { Y coordinate for most positive sample }
  MaxY:= CenterY+128;     { Y coordinate for most negative sample }

  MoveTo(0, MinY-1);      { border line for most positive sample  }
  LineTo(GetMaxX, MinY-1);
  MoveTo(0, MaxY+1);      { border line for most negative sample  }
  LineTo(GetMaxX, MaxY+1);

  SetViewPort(0, MinY, GetMaxX, MaxY, Clipoff);
  OutTextXY(0, -40, 'minimum/maximum/average/RMS amplitude: ');
  SetFillStyle(EmptyFill, Black);

  repeat
    Get_Samples(Samples);

    MoveTo(0, 127-Buf[1]);
    for x:= 2 to Samples do LineTo(x, 127-Buf[x+1]); { plot samples }

    { compute and print some statistical information }

    Compute_Statistics(Samples, Average, RMS_Amp, Min, Max);
    Str(Average:1:2, Ave);
    Str(RMS_Amp:1:2, RMS);
    Str(Min:1, Mi);
    Str(Max:1, Ma);
    Bar(308, -40, 480, -32); { whipe previous values from the screen }
    OutTextXY(308, -40, Mi + ' ' + Ma + ' ' + Ave + ' ' + RMS);

    Delay(1000);
    ClearviewPort { only the data area is cleared }
  until KeyPressed;

  CloseGraph
end;

{ ******* }

procedure ADC_To_DAC;

{ reroutes ADC input directly to DAC output }

begin
  repeat
    Port[ADC]:= Port[DAC]
  until KeyPressed
end;

{ ******* }

procedure Distortion;

{ reads ADC values, and outputs 100 to the DAC for the ones with absolute
  value>= Clip_Level. This produces a compressed and heavily distorted
  sound. }

const Clip_Level= 10; { should at least exceed the maximum value of absolute
                        noise samples }

var s: ShortInt;
    Table: array[-128..127] of ShortInt; { lookup table for fast execution }

begin
  for s:= -128 to 127 do
    if s>  Clip_Level then Table[s]:= 100 else
    if s< -Clip_Level then Table[s]:= 100 else { -100 for softer distortion }
                           Table[s]:= Abs(Round(s/Clip_Level*100));

  repeat
    Port[DAC]:= Table[ShortInt(Port[ADC])]
  until KeyPressed
end;

{ ******* }

procedure Echo;

{ produces an echo by adding ADC samples from some time ago to the present
  samples, and outputting the result to the DAC }

var i, j, d: Word;
    k, s, Pause, Buffers: Integer;
    Table: array[-128..127] of Integer; { lookup table for fast execution }
    Dr: Real;

begin
  Pause  := 20   ; { Pause determines the sampling frequency (40 kHz)       }
  d      := 20000; { d and Pause determine the delay time (20E3/40E3=0.5 s) }
  Dr     := 0.5  ; { Dr is inversely proportional to the decay rate         }
  Buffers:= 0    ; { number of Max_Sam byte Buffers processed               }

  for i:= 0 to Max_Sam do Buf[i]:= 0;            { clear buffer }
  for k:= -128 to 127 do Table[k]:= Round(Dr*k); { fill table }

  WriteLn; WriteLn; WriteLn;
  Write('Number of ', Max_Sam:1, ' byte buffers processed: ');

  repeat
    GotoXY(41,16);    { print the number of processed buffers indicating }
    Write(Buffers:1); { the sampling frequency }
    Inc(Buffers);

    for i:= 0 to Max_Sam do
    begin
      for k:= 1 to Pause do;                      { lower sampling frequency }
      if i>=d then j:= i-d else j:= i-d+Max_Sam+1; { j= index delayed sample }
      s:= ShortInt(Port[ADC]) + Table[Buf[j]];     { compute original + echo }
      if s<-128 then s:= -128 else if s>127 then s:= 127; { correct overflow }
      Buf[i]:= s;                                  { store compound sample   }
      Port[DAC]:= s                                { output sample to DAC    }
    end
  until KeyPressed
end;

{ ******* }

procedure Quit;

{ resets DAC output to 0 Volts and halts program }

begin
  Port[DAC]:= 0;
  Halt
end;

{ ******* }

procedure Menu;

{ presents the user different actions to choose from }

var i, Choice: Integer;
    Fs: Real; { sampling frequency determined by menu item 1 }

begin
  Fs:= 0; { sampling frequency not yet determined }

  repeat
    ClrScr;

    for i:= 1 to Length(Title)+4 do Write('*');
    WriteLn;